home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / basic / aa_array.zip / DEMO.FRM < prev    next >
Text File  |  1994-12-19  |  15KB  |  472 lines
  1. VERSION 2.00
  2. Begin Form frmTest 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   6825
  6.    ClientLeft      =   2775
  7.    ClientTop       =   2700
  8.    ClientWidth     =   6450
  9.    Height          =   7515
  10.    Left            =   2715
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   6825
  13.    ScaleWidth      =   6450
  14.    Top             =   2070
  15.    Width           =   6570
  16.    Begin ListBox List1 
  17.       Height          =   4125
  18.       Left            =   240
  19.       TabIndex        =   0
  20.       Top             =   1440
  21.       Width           =   5895
  22.    End
  23.    Begin Shape shapePercentComplete 
  24.       BackColor       =   &H0000FFFF&
  25.       BorderWidth     =   2
  26.       FillColor       =   &H00FF0000&
  27.       FillStyle       =   7  'Diagonal Cross
  28.       Height          =   255
  29.       Left            =   0
  30.       Top             =   6600
  31.       Width           =   4095
  32.    End
  33.    Begin Shape shapeBackGround 
  34.       BorderWidth     =   2
  35.       Height          =   255
  36.       Left            =   0
  37.       Top             =   6600
  38.       Width           =   6495
  39.    End
  40.    Begin Menu mnuFile 
  41.       Caption         =   "&File"
  42.       Begin Menu mnuFileExit 
  43.          Caption         =   "E&xit"
  44.       End
  45.    End
  46.    Begin Menu mnuStr 
  47.       Caption         =   "&String"
  48.       Begin Menu mnuStrNew 
  49.          Caption         =   "&New"
  50.       End
  51.       Begin Menu mnuStrOpen 
  52.          Caption         =   "&Open"
  53.       End
  54.       Begin Menu mnuStrAdd 
  55.          Caption         =   "&Add"
  56.       End
  57.       Begin Menu mnuStrClose 
  58.          Caption         =   "&Close"
  59.       End
  60.       Begin Menu mnuStrAbort 
  61.          Caption         =   "A&bort"
  62.       End
  63.    End
  64.    Begin Menu mnuDemo 
  65.       Caption         =   "&!Demo"
  66.    End
  67. End
  68. Option Explicit
  69.  
  70. 'Open
  71. Declare Function AryOpen Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal userTypeDefinition_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  72. Declare Function AryOpenInteger Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  73. Declare Function AryOpenLong Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  74. Declare Function AryOpenSingle Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  75. Declare Function AryOpenDouble Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  76. Declare Function AryOpenCurrency Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  77. Declare Function AryOpenString Lib "AA-Array.dll" (ByVal aryName_s As String, ByVal mode As Integer, ByVal password_s As String) As Integer
  78.  
  79. 'Close
  80. Declare Function AryClose Lib "AA-Array.dll" (ByVal ary_h As Integer) As Integer
  81. Declare Sub AryAbort Lib "AA-Array.dll" (ByVal ary_h As Integer)
  82.  
  83. 'Bounds
  84. Declare Sub ArySetBounds Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal minElement As Long, ByVal maxElement As Long)
  85. Declare Sub AryGetBounds Lib "AA-Array.dll" (ByVal ary_h As Integer, minElement As Long, maxElement As Long)
  86. Declare Function AryCheckIndex Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long) As Integer
  87.  
  88. 'Set Elements
  89. Declare Sub ArySetElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As Any)
  90. Declare Sub ArySetInteger Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Integer)
  91. Declare Sub ArySetLong Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Long)
  92. Declare Sub ArySetSingle Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Single)
  93. Declare Sub ArySetDouble Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Double)
  94. Declare Sub ArySetCurrency Lib "AA-Array.dll" Alias "ArySetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Currency)
  95. Declare Sub ArySetString Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As String)
  96.  
  97. 'Get Elements
  98. Declare Sub AryGetElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As Any)
  99. Declare Sub AryGetInteger Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Integer)
  100. Declare Sub AryGetLong Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Long)
  101. Declare Sub AryGetSingle Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Single)
  102. Declare Sub AryGetDouble Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Double)
  103. Declare Sub AryGetCurrency Lib "AA-Array.dll" Alias "AryGetElement" (ByVal ary_h As Integer, ByVal row_l As Long, value As Currency)
  104. Declare Sub AryGetString Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long, value As String)
  105.  
  106. 'Deletes
  107. Declare Sub AryDeleteElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long)
  108. Declare Sub AryDeleteAll Lib "AA-Array.dll" (ByVal ary_h As Integer)
  109.  
  110. 'Information
  111. Declare Function AryIsEmptyElement Lib "AA-Array.dll" (ByVal ary_h As Integer, ByVal row_l As Long) As Integer
  112. Declare Function AryGetStatus Lib "AA-Array.dll" (ByVal ary_h As Integer) As Integer
  113. Declare Function AryVersion Lib "AA-Array.dll" (ByVal info_i As Integer) As String
  114.  
  115. 'Match (registered version only)
  116. Declare Function AryMatchEntry Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Any, index_l As Long) As Integer
  117. Declare Function AryMatchInteger Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Integer, index_l As Long) As Integer
  118. Declare Function AryMatchLong Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Long, index_l As Long) As Integer
  119. Declare Function AryMatchSingle Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Single, index_l As Long) As Integer
  120. Declare Function AryMatchDouble Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Double, index_l As Long) As Integer
  121. Declare Function AryMatchCurrency Lib "AA-Array.dll" (ByVal ary_h As Integer, value As Currency, index_l As Long) As Integer
  122. Declare Function AryMatchString Lib "AA-Array.dll" (ByVal ary_h As Integer, value As String, index_l As Long) As Integer
  123.  
  124. Const AryUseExisting = 0
  125. Const AryCreateNew = 1
  126. Const AryReadOnly = 2
  127. Const AryReadWrite = 0
  128. Const AryNonPersistent = 4
  129. Const AryPersistent = 0
  130.  
  131. 'Integer/Long Array
  132. Dim mnuIntFileName_str As String
  133. Dim mnuIntArray_h As Integer
  134. Const mnuIntArrayLb = 1
  135. Const mnuIntArrayUb = 10
  136.  
  137. ' String Array
  138. Dim mnuStrFileName_str As String
  139. Dim mnuStrArray_h As Integer
  140. Const mnuStrArrayLb = 1
  141. Const mnuStrArrayUb = 10
  142.  
  143. ' Fixed String Array
  144. Dim mnuFixedStrFileName_str As String
  145. Dim mnuFixedStrArray_h As Integer
  146. Const mnuFixedStrArrayLb = 1
  147. Const mnuFixedStrArrayUb = 10
  148.  
  149. Dim hinstAAArrayDLL As Integer
  150.  
  151. Dim previousPercentage_i As Integer
  152.  
  153. Sub Form_Load ()
  154.    
  155.    'Indicate that there is no file open
  156.    mnuIntArray_h = -1
  157.    mnuStrArray_h = -1
  158.    mnuFixedStrArray_h = -1
  159.  
  160.    Me.Print AryVersion(0)
  161.    pBarPlaceAtBottom Me
  162.    previousPercentage_i = 0
  163.    pBarSet Me, 50
  164.    
  165. End Sub
  166.  
  167. Sub mnuDemo_Click ()
  168.          
  169.    list1.Clear
  170.    
  171.    'Create extended string array
  172.    pAddItem1 list1, "Creating Extended Array"
  173.    Dim strAry_h As Integer
  174.    strAry_h = AryOpenString("c:\tstStr.ary", AryCreateNew + AryPersistent, "")
  175.    If strAry_h < 0 Then
  176.       pAddItem1 list1, "Cannot create extended array."
  177.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  178.       Exit Sub
  179.    End If
  180.  
  181.    'Set the array's lower and upper bounds
  182.    Const firstElement = 1234567890
  183.    pAddItem1 list1, "Setting Bounds to: " & Str$(firstElement) & Str$(firstElement + 100)
  184.    ArySetBounds strAry_h, firstElement, firstElement + 100
  185.  
  186.    'Set every other element to something big
  187.    pAddItem1 list1, "Setting Every Other Element"
  188.    Dim dummyString As String
  189.    dummyString = Space(1311)
  190.    Dim i As Long
  191.    For i = firstElement To firstElement + 100 Step 2
  192.       ArySetString strAry_h, i, Str$(i) & dummyString
  193.    Next i
  194.  
  195.    pAddItem1 list1, "Closing Extended Array"
  196.    Dim retval As Integer
  197.    retval = AryClose(strAry_h)
  198.    If retval < 0 Then
  199.       pAddItem1 list1, "Cannot write extended array to disk."
  200.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  201.       Exit Sub
  202.    End If
  203.  
  204.    'Open extended string array
  205.    pAddItem1 list1, "Reopening Extended Array"
  206.    strAry_h = AryOpenString("c:\tstStr.ary", AryUseExisting + AryPersistent, "")
  207.    If strAry_h < 0 Then
  208.       pAddItem1 list1, "Cannot open extended array."
  209.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  210.       Exit Sub
  211.    End If
  212.  
  213.    'Get the array's lower and upper bounds
  214.    Dim lowerBound As Long
  215.    Dim upperBound As Long
  216.    AryGetBounds strAry_h, lowerBound, upperBound
  217.    pAddItem1 list1, "Retrieved Bounds: " & Str$(lowerBound) & Str$(upperBound)
  218.  
  219.    'Get every element
  220.    pAddItem1 list1, "Retrieved Element Values (i=value)"
  221.    Dim retString As String
  222.    retString = Space(1311)
  223.    For i = lowerBound To upperBound
  224.       AryGetString strAry_h, i, retString
  225.       list1.AddItem Str$(i) & "='" & Trim$(retString) & "'"
  226.    Next i
  227.  
  228.    pAddItem1 list1, "Closing Extended Array"
  229.    retval = AryClose(strAry_h)
  230.    If retval < 0 Then
  231.       pAddItem1 list1, "Cannot write extended array to disk."
  232.       pAddItem1 list1, "Error code is: " & Str$(strAry_h)
  233.       Exit Sub
  234.    End If
  235.  
  236. End Sub
  237.  
  238. Sub mnuFileExit_Click ()
  239.    End
  240. End Sub
  241.  
  242. Sub mnuStrAbort_Click ()
  243. '= Abort an extended array.
  244.  
  245.    list1.Clear
  246.  
  247.    If mnuStrArray_h >= 0 Then
  248.  
  249.       AryAbort mnuStrArray_h
  250.       
  251.       mnuStrArray_h = -1
  252.       pAddItem1 list1, "File: " & mnuStrFileName_str & " Aborted"
  253.    
  254.    Else
  255.       
  256.       pAddItem1 list1, "File: " & mnuStrFileName_str & " Not Opended"
  257.    
  258.    End If
  259.  
  260. End Sub
  261.  
  262. Sub mnuStrAdd_Click ()
  263. '= Add something to each element of the extended array.
  264.  
  265.    '
  266.    ' Make sure array is already opended
  267.    '
  268.    If mnuStrArray_h < 0 Then
  269.       pAddItem1 list1, "Extended array not opended"
  270.       Exit Sub
  271.    End If
  272.  
  273.    '
  274.    ' Get array bounds
  275.    '
  276.    Dim lb As Long, ub As Long
  277.  
  278.    AryGetBounds mnuStrArray_h, lb, ub
  279.    
  280.    '
  281.    ' Do the add to each element
  282.    '
  283.    Dim t As String
  284.  
  285.    Dim i As Long
  286.    For i = lb To ub
  287.  
  288.       'Get the element
  289.       AryGetString mnuStrArray_h, i, t
  290.  
  291.       ' Add a bit
  292.       t = Str$(Val(t) + 1)
  293.  
  294.       'Set the new value of the element
  295.       ArySetString mnuStrArray_h, i, t
  296.  
  297.    Next i
  298.  
  299.    list1.Refresh
  300.    pAddItem1 list1, "Added a bit to all elements"
  301.  
  302. End Sub
  303.  
  304. Sub mnuStrClose_Click ()
  305. '= Close an extended array.
  306.  
  307.    list1.Clear
  308.  
  309.    '
  310.    ' Close previously opended file.
  311.    '
  312.    pCloseArray mnuStrArray_h
  313.    pAddItem1 list1, "File: " & mnuStrFileName_str & " Closed"
  314.  
  315. End Sub
  316.  
  317. Sub mnuStrNew_Click ()
  318. '= Create new extended array. Zero's all elements
  319.  
  320.    Dim retval As Integer
  321.    
  322.    list1.Clear
  323.  
  324.    '
  325.    ' Close previously opended file.
  326.    '
  327.    pCloseArray mnuStrArray_h
  328.  
  329.    '
  330.    ' Create new extended array of type testIntLong
  331.    '
  332.    Do
  333.       mnuStrFileName_str = InputBox$("Enter array name", "New", mnuStrFileName_str)
  334.       If mnuStrFileName_str = "" Then Exit Sub
  335.  
  336.       mnuStrArray_h = AryOpenString(mnuStrFileName_str, AryCreateNew + AryPersistent, "")
  337.       pAddItem1 list1, "AryOpenString: " & Str$(mnuStrArray_h)
  338.    Loop While mnuStrArray_h < 0
  339.    pAddItem1 list1, "File: " & mnuStrFileName_str & " Created"
  340.    list1.Refresh
  341.  
  342.  
  343.    '
  344.    ' Set array bounds
  345.    '
  346.    ArySetBounds mnuStrArray_h, mnuStrArrayLb, mnuStrArrayUb
  347.    pAddItem1 list1, "Bounds set to:" & Str$(mnuStrArrayLb) & Str$(mnuStrArrayUb)
  348.    list1.Refresh
  349.  
  350.    '
  351.    ' Zero all elements of array
  352.    '
  353.    Dim t As String
  354.  
  355.    Dim i As Long
  356.    For i = mnuStrArrayLb To mnuStrArrayUb
  357.       t = Str$(i)
  358.       ArySetString mnuStrArray_h, i, t
  359.    Next i
  360.    pAddItem1 list1, "Zeroed all elements"
  361.    list1.Refresh
  362.  
  363.    '
  364.    ' Close extended array
  365.    '
  366.    pCloseArray mnuStrArray_h
  367.    pAddItem1 list1, "Extended array closed."
  368.    list1.Refresh
  369.  
  370. End Sub
  371.  
  372. Sub mnuStrOpen_Click ()
  373. '= Opens an extended array. Prints all elements on form. Leaves it open.
  374.  
  375.    list1.Clear
  376.  
  377.    '
  378.    ' Ensure array is open
  379.    '
  380.    If mnuStrArray_h < 0 Then   'Array not open
  381.  
  382.       '
  383.       ' Open extended array of type testIntLong
  384.       '
  385.       Do
  386.          mnuStrFileName_str = InputBox$("Enter array name", "Open", mnuStrFileName_str)
  387.          If mnuStrFileName_str = "" Then Exit Sub
  388.  
  389.          mnuStrArray_h = AryOpenString(mnuStrFileName_str, AryUseExisting + AryPersistent, "")
  390.          pAddItem1 list1, "AryOpenString" & Str$(mnuStrArray_h)
  391.       Loop While mnuStrArray_h < 0
  392.       pAddItem1 list1, "File: " & mnuStrFileName_str & " Opened"
  393.       list1.Refresh
  394.    End If
  395.  
  396.    '
  397.    ' Show array bounds
  398.    '
  399.    Dim lb As Long, ub As Long
  400.    AryGetBounds mnuStrArray_h, lb, ub
  401.    
  402.    pAddItem1 list1, "Bounds: " & Str$(lb) & Str$(ub)
  403.    list1.Refresh
  404.  
  405.    '
  406.    ' Display all elements of array
  407.    '
  408.    Dim t As String
  409.  
  410.    pAddItem1 list1, "Element=t.str"
  411.    Dim i As Long
  412.    For i = lb To ub
  413.       AryGetString mnuStrArray_h, i, t
  414.       pAddItem1 list1, Str$(i) & "=" & t
  415.    Next i
  416.    list1.Refresh
  417.  
  418. End Sub
  419.  
  420. Sub pAddItem1 (c As Control, s As String)
  421.  
  422.    c.AddItem s
  423.    c.Refresh
  424.  
  425. End Sub
  426.  
  427. Sub pBarPlaceAtBottom (f As Form)
  428.    
  429.    f.shapeBackGround.Left = 0
  430.    f.shapeBackGround.Width = f.Width
  431.    f.shapeBackGround.Top = f.ScaleHeight - f.shapeBackGround.Height
  432.  
  433.    
  434.    f.shapePercentComplete.Left = f.shapeBackGround.Left
  435.    f.shapePercentComplete.Width = f.shapeBackGround.Width
  436.    f.shapePercentComplete.Top = f.shapeBackGround.Top
  437. End Sub
  438.  
  439. Sub pBarSet (f As Form, percentage_i As Integer)
  440.  
  441.    If Abs(percentage_i - previousPercentage_i) < 5 Then Exit Sub
  442.  
  443.    previousPercentage_i = percentage_i
  444.  
  445.    f.shapePercentComplete.Width = f.shapeBackGround.Width * (percentage_i / 100#)
  446.    f.shapePercentComplete.Refresh
  447. End Sub
  448.  
  449. Sub pCloseArray (ary_h As Integer)
  450.    
  451.    If ary_h >= 0 Then
  452.       Dim retval As Integer
  453.       retval = AryClose(ary_h)
  454.       ary_h = -1
  455.       If retval < 0 Then
  456.          pAddItem1 list1, "Error closing previously opened arrry. Error Code:" & Str$(retval)
  457.       End If
  458.    End If
  459.  
  460. End Sub
  461.  
  462. Sub pGetBounds (l As Variant, u As Variant)
  463.  
  464.    If IsEmpty(l) Then l = 0&
  465.    If IsEmpty(u) Then u = 100&
  466.  
  467.    l = InputBox$("Lower", "Bound", Str$(l))
  468.    u = InputBox$("Upper", "Bound", Str$(u))
  469.  
  470. End Sub
  471.  
  472.